home *** CD-ROM | disk | FTP | other *** search
GW-BASIC | 1984-04-06 | 19.3 KB | 480 lines |
- 1010 ' *** OKIMENU.BAS Print Control Menu for Okidata ML92
- 1020 '
- 1030 KEY OFF: SCREEN 0,1,0,0: WIDTH 80: CLS 'Use 25-line 80-column screen
- 1040 DEFINT A-Z: BV=1: CG=0: LI$="?" 'Use integer variables
- 1050 ON ERROR GOTO 1060: E=TIMER/3: BV=2: GOTO 1070 'Get BASIC version
- 1060 RESUME 1070
- 1070 ON ERROR GOTO 0
- 1080 DEF SEG=0: IF (PEEK(&H410) AND &H30)<&H30 THEN CG=1 'Color/Graphics
- 1090 DEF SEG: IF CG=1 THEN SCREEN 0,1,1,0: CLS 'Build page 1 for C/G
- 1100 OPTION BASE 1: DIM PC$(26),PN$(34) 'Print code & name arrays
- 1110 '
- 1120 LOCATE 2,10: PRINT "OKIDATA MicroLine 92 Print Control Menu"
- 1130 LOCATE 4,10: PRINT " Version 2.94 March 20, 1984"
- 1140 LOCATE 6,10: PRINT "Copyright (C)1984 BWare SoftWare EveryWare"
- 1150 '
- 1160 BG=SCREEN(2,10,1): FG=BG MOD 16 'Save foreground color
- 1170 BG=(((BG-FG)/16) MOD 128) 'Save background color
- 1180 '
- 1190 LOCATE 11
- 1200 PRINT "LIMITED WARRANTY: This program is guaranteed against exterior body rust"
- 1210 PRINT "for five years or 50,000 miles, whichever comes first. No other warranty"
- 1220 PRINT "is expressed or implied. Our motto is CAVEAT EMPTOR!"
- 1230 LOCATE 15
- 1240 PRINT "SERVICE AGREEMENT: You get what you pay for!"
- 1250 LOCATE 17
- 1260 PRINT "LICENSE AGREEMENT: This program may be freely copied or modified,"
- 1270 PRINT "but SALE of this program is STRICTLY FORBIDDEN without the express"
- 1280 PRINT "written permission of BWare SoftWare EveryWare. Remember,"
- 1290 PRINT "selling SoftWare from B.S.EveryWare will get you NoWhere!"
- 1300 LOCATE 23
- 1310 PRINT "This program is made available through the Software Library of the"
- 1320 PRINT "Silicon Valley Computer Society, P.O. Box 60506, Sunnyvale, CA 94088";
- 1330 IF CG=1 THEN SCREEN ,,0,1: CLS 'Display page 1 for C/G
- 1340 '
- 1350 E=VAL(MID$(TIME$,7)) 'Get current seconds
- 1360 '
- 1370 RESTORE 5150 'Set to read print codes
- 1380 FOR I=1 TO 26 'Load print code array
- 1390 READ PN$(I) 'Read print code name
- 1400 READ R 'Read next control code
- 1410 IF R<255 THEN R$=R$+CHR$(R): GOTO 1400 'Get all codes for function
- 1420 PC$(I)=R$: R$="": NEXT I 'Store control codes
- 1430 '
- 1440 RESTORE 5710 'Set to read function names
- 1450 FOR I=27 TO 34: READ PN$(I): NEXT I 'Load print function names
- 1460 '
- 1470 IF CG=1 THEN 1550 'Proceed if Color/Graphics
- 1480 IF INKEY$>"" THEN 1540 'Proceed if any key pressed
- 1490 I=VAL(MID$(TIME$,7)): IF I<E THEN I=I+60 'Get current seconds
- 1500 IF I-E<10 THEN 1480 ELSE 1540 'Delay 10 seconds
- 1510 '
- 1520 '*** Start of screen rewrite loop
- 1530 IF CG=1 THEN SCREEN ,,0,1 'Build page 0 for C/G
- 1540 CLS
- 1550 PRINT "OKIDATA ML92 Print Control Menu";
- 1560 LOCATE ,50: PRINT DATE$" "TIME$: PRINT
- 1570 FOR I=1 TO 13: PRINT CHR$(I+64)". "PN$(I); 'Print function name menu
- 1580 LOCATE ,41: PRINT CHR$(I+77)". "PN$(I+13): NEXT I
- 1590 PRINT: PRINT "** Not compatible with CQ print mode";
- 1600 LOCATE ,41: PRINT "* Compatible only with CQ print mode"
- 1610 PRINT
- 1620 FOR I=27 TO 30: PRINT CHR$(I+22)". "PN$(I); 'Print special function menu
- 1630 LOCATE ,41: PRINT CHR$(I+26)". "PN$(I+4): NEXT I
- 1640 '
- 1650 IF CG=1 THEN SCREEN ,,0,0 'Display page 0 for C/G
- 1660 '
- 1670 '*** Start of menu-selection loop
- 1680 ON ERROR GOTO 0: GOSUB 2200: COLOR 0,7 'Message in reverse video
- 1690 PRINT " Enter selection: ";: COLOR FG,BG
- 1700 E=1: L=0: GOSUB 2320 'Get single unedited char.
- 1710 IF R=27 THEN 1530 'Esc means rewrite screen
- 1720 IF R$<"1" THEN 1820 ELSE IF R$>"8" THEN 1800 'Skip if not print function
- 1730 '
- 1740 PF=R-48: R=PF+26: GOSUB 2190: PRINT PN$(R); 'Display print function name
- 1750 ON PF GOSUB 3610,3770,3840,4260,4690,4870,5020,5070 'Do menu items 1-8
- 1760 GOSUB 2200: IF PF=4 OR PF=5 THEN 1530 'Rewrite screen for 4 & 5
- 1770 GOTO 1680 'Continue with next selection
- 1780 '
- 1790 '*** Process menu selections A-Z
- 1800 R=R-64 'Convert letter to subscript
- 1810 IF R>0 AND R<27 THEN 1850 'Check for invalid selections
- 1820 GOSUB 2190: BEEP 'Clear line 24
- 1830 PRINT "Invalid selection";: GOTO 1700 'Handle invalid selections
- 1840 '
- 1850 A$=PC$(R): IF A$="" THEN 1820 'Retrieve print code
- 1860 GOSUB 2190: PRINT PN$(R); 'Display print function name
- 1870 LOCATE ,41: PRINT "Make sure printer is ready";
- 1880 IF R=12 THEN LI$="6": GOTO 1970 'L. Lines per inch
- 1890 IF R=13 THEN LI$="8": GOTO 1970 'M. Lines per inch
- 1900 IF R=16 THEN GOSUB 2550: GOTO 1960 'P. Sub/superscripts on
- 1910 IF R=18 THEN GOSUB 2670: GOTO 1970 'R. Set variable tabs
- 1920 IF R=19 THEN GOSUB 2860: GOTO 1970 'S. Set fixed tabs
- 1930 IF R=21 THEN GOSUB 3110: GOTO 1970 'U. Page length
- 1940 IF R=24 THEN GOSUB 3240: GOTO 1970 'X. Skip lines
- 1950 IF R=25 THEN GOSUB 3360: GOTO 1970 'Y. Left margin
- 1960 IF R=26 THEN GOSUB 3490 'Z. Space between characters
- 1970 GOSUB 2030: GOTO 1680 'Print codes & start over
- 1980 '
- 1990 '
- 2000 '
- 2010 '
- 2020 '*** Sub-routine to send print codes
- 2030 ON ERROR GOTO 2080 'Set error catcher
- 2040 OPEN "R",#1,"LPT1:": WIDTH #1,255 'Open printer/no LF's
- 2050 PRINT #1,A$; 'Send print string
- 2060 CLOSE #1: ON ERROR GOTO 0: RETURN 'Close & return
- 2070 '
- 2080 IF ERR=55 THEN CLOSE: RESUME 'Ignore "Open file" error
- 2090 IF ERL<>2050 THEN ON ERROR GOTO 0 'Must be print error
- 2100 GOSUB 2210: PRINT "Check printer - press <Enter> to continue";
- 2110 LOCATE 24,41: PRINT "Press <Esc> to cancel selection";
- 2120 BEEP: E=1: L=0: GOSUB 2320 'Get response
- 2130 IF R=27 THEN RESUME 2060 'Esc means cancel
- 2140 IF R=13 THEN RESUME ELSE 2120 'Ignore if not Enter key
- 2150 '
- 2160 '
- 2170 '
- 2180 '*** Sub-routines to clear lines 24 & 25
- 2190 LOCATE 24,1: PRINT SPACE$(79);: LOCATE 24,1: RETURN 'Clear line 24
- 2200 LOCATE 24,41: PRINT SPACE$(39); 'Clear line 24 right
- 2210 LOCATE 25,1: PRINT SPACE$(79);: LOCATE 25,1: RETURN 'Clear line 25
- 2220 '
- 2230 '
- 2240 '
- 2250 '*** Sub-routine to get keyboard response (terminated by <Enter>)
- 2260 '*** E=1 is no edit / E=2 is alpha edit / E=3 is numeric edit
- 2270 '*** E=4 is numeric edit terminated by comma or <Enter>
- 2280 '*** L is the maximum length of response (0=one unprinted character)
- 2290 '*** R$ is the last character entered
- 2300 '*** R is the ASCII code of R$
- 2310 '*** S$ is the cumulative string entered
- 2320 S$="": X=CSRLIN: Y=POS(0): GOTO 2340 'Initialize string
- 2330 BEEP 'Complain if wrong key pressed
- 2340 R$=INKEY$: IF R$="" THEN LOCATE 1,64,0: PRINT TIME$;: GOTO 2340 'Get char.
- 2350 IF LEN(R$)>1 THEN 2330 'Ignore extended codes
- 2360 R=ASC(R$): IF R=13 THEN RETURN '<Enter> key ends response
- 2370 IF R=27 THEN S$="": RETURN '<Esc> key cancels response
- 2380 IF R=8 THEN 2470 'Special handling for BackSpace
- 2390 IF R>96 AND R<123 THEN R=R-32: R$=CHR$(R) 'Force uppercase letters
- 2400 ON E GOTO 2440,2430,2420,2410: GOTO 2330 'Check edit type
- 2410 IF R$="," THEN RETURN 'Comma ends input for edit 4
- 2420 IF R$<"0" OR R$>"9" THEN 2330 ELSE 2440 'Edit numeric entry
- 2430 IF R$<"A" OR R$>"Z" THEN 2330 'Edit alphabetic entry
- 2440 IF L=0 THEN RETURN 'Do not print character if L=0
- 2450 S$=S$+R$: Y=Y+1: LOCATE X,Y: PRINT R$; 'Add new character to string
- 2460 IF LEN(S$)<L THEN 2340 ELSE RETURN 'Keep going until max. response
- 2470 IF LEN(S$)<1 THEN 2330 'Ignore BackSpace if no string
- 2480 S$=LEFT$(S$,LEN(S$)-1) 'Delete last character
- 2490 LOCATE X,Y: Y=Y-1: PRINT CHR$(32); 'Erase character from screen
- 2500 GOTO 2340 'Get next character
- 2510 '
- 2520 '
- 2530 '
- 2540 '*** Sub-routine to turn on subscripts or superscripts
- 2550 LOCATE ,41: PRINT "Press <Esc> to cancel selection";
- 2560 GOSUB 2210: COLOR 0,7
- 2570 PRINT " Type <B> for subscripts, <P> for superscripts: ";
- 2580 COLOR FG,BG: E=2: L=1: GOSUB 2320 'Get suB/suPerscript choice
- 2590 IF R=27 THEN A$="": RETURN 'Esc means cancel
- 2600 IF R$="B" THEN RETURN 'Subscripts chosen
- 2610 IF R$<>"P" THEN BEEP: GOTO 2560 'Try again if not suPerscripts
- 2620 A$=CHR$(27)+"K"+CHR$(27)+"M"+CHR$(27)+"J": RETURN 'Set control string
- 2630 '
- 2640 '
- 2650 '
- 2660 '*** Sub-routine to set variable horizontal tab stops
- 2670 TB$="": LOCATE ,41: PRINT "Press <Esc> to cancel selection";
- 2680 GOSUB 2210: COLOR 0,7: PRINT " Enter columns (1-255)";
- 2690 COLOR FG,BG: PRINT TB$+" "; 'Show tabs entered so far
- 2700 E=4: L=4: GOSUB 2320 'Get column number
- 2710 IF R=27 THEN A$="": RETURN 'Esc means cancel
- 2720 IF LEN(S$)=0 THEN 2800 'No entry means finished
- 2730 R=VAL(S$) 'Get column number
- 2740 IF R=0 OR R>255 THEN BEEP: GOTO 2680 'Column must be 1-255
- 2750 IF LEN(S$)<3 THEN S$="0"+S$: GOTO 2750 'Must be 3-digit tab column
- 2760 IF LEN(S$)>3 THEN BEEP: GOTO 2680 'Can't be more than 3 digits
- 2770 IF TB$>"" THEN TB$=TB$+"," 'Need comma between tabs
- 2780 TB$=TB$+S$: IF R>233 THEN 2800 'Only one tab allowed 234-255
- 2790 IF LEN(TB$)<52 THEN 2680 'Room for 14 tabs on line
- 2800 IF LEN(TB$)=0 THEN A$="": RETURN 'Done if no entry
- 2810 A$=A$+TB$+CHR$(13): RETURN 'Set tab string
- 2820 '
- 2830 '
- 2840 '
- 2850 '*** Sub-routine to set fixed horizontal tab stops
- 2860 TB$="": LOCATE ,41: PRINT "Press <Esc> to cancel selection";
- 2870 GOSUB 2210: COLOR 0,7 'Clear line 25 & reverse video
- 2880 PRINT " Enter number of columns between tab stops ";
- 2890 COLOR FG,BG: E=3: L=4: GOSUB 2320 'Get tab interval
- 2900 IF R=27 THEN A$="": RETURN 'Esc means cancel
- 2910 IF LEN(S$)=0 THEN A$="": RETURN 'No entry means finished
- 2920 IF LEN(S$)>3 THEN BEEP: GOTO 2870 'Only 3 digits allowed
- 2930 R=VAL(S$): A=R+1 'Get starting tab column
- 2940 IF R=0 OR R>254 THEN BEEP: GOTO 2870 'Tab interval must be 1-254
- 2950 FOR I=1 TO 16 'Limit is 16 tab stops
- 2960 IF A>255 THEN 3030 'Column cannot exceed 255
- 2970 S$=MID$(STR$(A),2) 'Convert column number to string
- 2980 IF LEN(S$)<3 THEN S$="0"+S$: GOTO 2980 'Must be 3-digit column number
- 2990 IF TB$>"" THEN TB$=TB$+"," 'Need comma between tabs
- 3000 TB$=TB$+S$ 'Store tab string
- 3010 IF A>233 THEN 3030 ELSE A=A+R 'Only one tab allowed 234-255
- 3020 NEXT I
- 3030 GOSUB 2190: PRINT "Tabs set at "TB$; 'Show tab stops
- 3040 A$=A$+TB$+CHR$(13) 'Set tab string
- 3050 LOCATE 25,52: PRINT "Press any key to continue";
- 3060 IF INKEY$="" THEN 3060 ELSE GOSUB 2190: RETURN
- 3070 '
- 3080 '
- 3090 '
- 3100 '*** Sub-routine to get number of lines/page
- 3110 LOCATE ,41: PRINT "Press <Esc> to cancel selection";
- 3120 GOSUB 2210: COLOR 0,7
- 3130 PRINT " Enter number of lines per page (00-99) at "LI$" LPI: ";
- 3140 COLOR FG,BG: E=3: L=3: GOSUB 2320 'Get number of lines
- 3150 IF R=27 THEN A$="": RETURN 'Esc means cancel
- 3160 IF LEN(S$)=1 THEN S$="0"+S$: GOTO 3180
- 3170 IF LEN(S$)>2 THEN BEEP: GOTO 3120
- 3180 A$=A$+S$: GOSUB 2190
- 3190 PRINT "Form length set to "S$" lines at "LI$" LPI";: RETURN
- 3200 '
- 3210 '
- 3220 '
- 3230 '*** Sub-routine to get number of lines to skip
- 3240 LOCATE ,41: PRINT "Press <Esc> to cancel selection";
- 3250 GOSUB 2210: COLOR 0,7
- 3260 PRINT " Enter number of lines to skip (00-99): ";
- 3270 COLOR FG,BG: E=3: L=3: GOSUB 2320 'Get number of lines
- 3280 IF R=27 THEN A$="": RETURN 'Esc means cancel
- 3290 IF LEN(S$)=1 THEN S$="0"+S$: GOTO 3310
- 3300 IF LEN(S$)>2 THEN BEEP: GOTO 3250
- 3310 A$=A$+S$: RETURN
- 3320 '
- 3330 '
- 3340 '
- 3350 '*** Sub-routine to get left margin print position
- 3360 LOCATE ,41: PRINT "Press <Esc> to cancel selection";
- 3370 GOSUB 2210: COLOR 0,7
- 3380 PRINT " Enter left margin column number (1-90): ";
- 3390 COLOR FG,BG: E=3: L=4: GOSUB 2320 'Get column number
- 3400 IF R=27 THEN A$="": RETURN ELSE R=VAL(S$) 'Esc means cancel
- 3410 IF R<1 OR R>90 THEN BEEP: GOTO 3370 'Must be column 1-90
- 3420 S$=MID$(STR$(VAL(S$)*10-9),2) 'Multiply by 10 dots/inch
- 3430 IF LEN(S$)<3 THEN S$="0"+S$: GOTO 3430 'Make it 3 digits
- 3440 A$=A$+S$: RETURN
- 3450 '
- 3460 '
- 3470 '
- 3480 '*** Sub-routine to get spacing between characters (# of 1/120's)
- 3490 LOCATE ,41: PRINT "Press <Esc> to cancel selection";
- 3500 GOSUB 2210: COLOR 0,7
- 3510 PRINT " Enter number of 1/120-inch spaces between characters (0-9): ";
- 3520 COLOR FG,BG: E=3: L=2: GOSUB 2320 'Get number of 1/120's
- 3530 IF R=27 THEN A$="": RETURN 'Esc means cancel
- 3540 IF LEN(S$)>1 THEN BEEP: GOTO 3500
- 3550 A$=A$+CHR$(ASC(S$)-48): RETURN
- 3560 '
- 3570 '
- 3580 '
- 3590 '
- 3600 '*** Sub-routine to download Italics character set
- 3610 D$="": BAS$="OKITALIC.BAS"
- 3620 ON ERROR GOTO 3650
- 3630 OPEN "I",#1,D$+BAS$: CLOSE: ON ERROR GOTO 0
- 3640 CHAIN D$+BAS$,2020
- 3650 RESUME 3660
- 3660 ON ERROR GOTO 0: GOSUB 2210: COLOR 0,7
- 3670 PRINT " Enter letter of drive containing "BAS$": ";
- 3680 BEEP: COLOR FG,BG
- 3690 LOCATE 24,41: PRINT "Press <Esc> to cancel selection";
- 3700 LOCATE 25,50: E=2: L=1: GOSUB 2320 'Get drive letter
- 3710 IF R=27 THEN RETURN 'Esc means cancel
- 3720 D$=R$+":": GOTO 3620
- 3730 '
- 3740 '
- 3750 '
- 3760 '*** Sub-routine to do a print test
- 3770 LOCATE ,41: PRINT "Make sure printer is ready";
- 3780 A$="": FOR I=32 TO 127: A$=A$+CHR$(I): NEXT I
- 3790 A$=A$+CHR$(13)+CHR$(10): GOSUB 2030: RETURN
- 3800 '
- 3810 '
- 3820 '
- 3830 '*** Sub-routine to print an ASCII text file
- 3840 LOCATE ,41: PRINT "Press <Esc> to cancel selection";
- 3850 GOSUB 2210: COLOR 0,7
- 3860 PRINT " Enter number of print lines per page: ";
- 3870 COLOR FG,BG: E=3: L=4: GOSUB 2320 'Get response
- 3880 IF R=27 THEN RETURN 'Esc means cancel
- 3890 IF S$="" THEN PL=-1: LP=PL: GOTO 3920 'Set no-line-check
- 3900 PL=VAL(S$): LP=PL: GOTO 3920 'Set # lines per page
- 3910 LOCATE ,41: PRINT "Press <Esc> to cancel selection";
- 3920 GOSUB 2210: COLOR 0,7
- 3930 PRINT " Enter name of ASCII text file: ";
- 3940 COLOR FG,BG: E=1: L=15: GOSUB 2320 'Get file name
- 3950 IF S$="" THEN RETURN 'Skip it if no file name
- 3960 ON ERROR GOTO 4140 'Set error-catcher
- 3970 OPEN "I",#2,S$ 'Open the file
- 3980 IF EOF(2) THEN GOSUB 2190: PRINT S$" is an empty file";: GOTO 4120
- 3990 LINE INPUT #2,A$: IF A$="" THEN 4040 'Check for blank first line
- 4000 R=ASC(A$): IF R<128 THEN 4020 'Check for non-ASCII file
- 4010 GOSUB 2190: PRINT S$" is not an ASCII file";: CLOSE: GOTO 3910
- 4020 IF R<>12 THEN 4040 'Check for form-feed to start
- 4030 IF LEN(A$)<2 THEN 3990 ELSE A$=MID$(A$,2) 'Delete starting form-feed
- 4040 LOCATE 24,1: PRINT SPACE$(40);: LOCATE ,1: PRINT "Printing "S$;
- 4050 OPEN "O",#1,"LPT1:": WIDTH #1,255: GOTO 4090 'Ready the printer
- 4060 '
- 4070 IF EOF(2) THEN PRINT #1,CHR$(12);: GOTO 4120 'Check for end of file
- 4080 LINE INPUT #2,A$ 'Read the next line
- 4090 IF LP=0 THEN LP=PL: PRINT #1,CHR$(12); 'Form-feed after PL lines
- 4100 PRINT #1,A$: IF LP>0 THEN LP=LP-1 'Print the line
- 4110 R$=INKEY$: IF R$="" THEN 4070 ELSE IF ASC(R$)<>27 THEN 4110 'Continue
- 4120 CLOSE: ON ERROR GOTO 0: RETURN 'Close files - all done
- 4130 '
- 4140 IF ERL=3970 THEN 4160 ELSE IF ERL=4100 THEN 4170
- 4150 IF ERL=3990 THEN RESUME 4010 ELSE ON ERROR GOTO 0
- 4160 GOSUB 2190: PRINT "Bad file name - try again";: RESUME 3910
- 4170 GOSUB 2210: PRINT "Check printer - press <Enter> when ready";
- 4180 BEEP: E=1: L=0: GOSUB 2320 'Get response
- 4190 IF R=27 THEN RESUME 4120 'Esc means cancel
- 4200 IF R=13 THEN RESUME 4100 ELSE 4180 'Ignore if not Enter key
- 4210 '
- 4220 '
- 4230 '
- 4240 '*** Sub-routine to print disk directory in standard DOS format
- 4250 '*** using DOS & BASIC 2.0 features.
- 4260 IF BV=2 THEN 4280 ELSE BEEP: PF=0 'Function requires BASIC 2.00
- 4270 GOSUB 2190: PRINT "Sorry - BASIC 2.00 function";: RETURN
- 4280 CLS: LOCATE 2: PRINT PN$(R)
- 4290 PRINT: PRINT "Press <Esc> to cancel selection"
- 4300 PRINT: COLOR 0,7
- 4310 PRINT " Enter letter of disk drive: ";: COLOR FG,BG
- 4320 E=2: L=O: GOSUB 2320 'Get response
- 4330 IF R=27 THEN RETURN 'Esc means exit
- 4340 IF R$<"E" THEN 4360 'Only valid drive letters
- 4350 S$="": GOSUB 2330: GOTO 4330 'Try another letter
- 4360 LOCATE X,Y: PRINT R$: D$=R$ 'Show drive letter
- 4370 '
- 4380 PRINT: PRINT "Make sure printer is ready";
- 4390 ON ERROR GOTO 4570: OPEN "R",#1,"LPT1:": WIDTH #1,255
- 4400 PRINT #1,CHR$(17)CHR$(24)CHR$(27)"1"CHR$(30)CHR$(28)CHR$(27)"8"
- 4410 PRINT #1,CHR$(27)"%C001": CLOSE: ON ERROR GOTO 0
- 4420 '
- 4430 CMD$="dir "+D$+":>prn": GOSUB 4520 'Print the disk directory
- 4440 PRINT: PRINT: PRINT: PRINT
- 4450 '
- 4460 ON ERROR GOTO 4570: OPEN "R",#1,"LPT1:": WIDTH #1,255
- 4470 PRINT #1,CHR$(13)+CHR$(10)+CHR$(10): CLOSE: ON ERROR GOTO 0
- 4480 '
- 4490 CMD$="chkdsk "+D$+":>prn": GOSUB 4520 'Print the chkdsk report
- 4500 RETURN
- 4510 '
- 4520 DEF SEG: A=PEEK(&H30): B=PEEK(&H31) 'Save BASIC's current segment
- 4530 SHELL CMD$ 'Execute the DOS command
- 4540 POKE &H30,A: POKE &H31,B 'Restore BASIC's segment
- 4550 RETURN
- 4560 '
- 4570 IF ERR=55 THEN CLOSE: RESUME 'Ignore "File already open"
- 4580 CLS: IF ERR=24 OR ERR=25 THEN PRINT "Printer is not ready": RESUME 4610
- 4590 IF ERR=27 THEN PRINT "Printer is out of paper": RESUME 4610
- 4600 ON ERROR GOTO 0 'For unexpected errors
- 4610 PRINT "Press <Enter> when ready to continue (Esc to exit)"
- 4620 BEEP: E=1: L=0: GOSUB 2320 'Get response
- 4630 IF R=27 THEN ON ERROR GOTO 0: CLOSE: RETURN 'Esc means exit
- 4640 IF R<>13 THEN 4620 'Enter means try again
- 4645 IF ERL < 4460 THEN 4400 ELSE 4470 'Choose retry line
- 4650 '
- 4660 '
- 4670 '
- 4680 '*** Sub-routine to display disk directory
- 4690 LOCATE 24,41: PRINT "Press <Esc> to cancel selection";
- 4700 GOSUB 2210: COLOR 0,7
- 4710 PRINT " Enter letter of disk drive: ";: COLOR FG,BG
- 4720 E=2: L=1: GOSUB 2320 'Get response
- 4730 IF R=27 THEN RETURN 'Esc means cancel
- 4740 IF S$>"D" THEN BEEP: LOCATE X,Y-1: GOTO 4720 'Check valid drive letter
- 4750 IF CG=1 THEN SCREEN ,,2,0 'Build page 2 for C/G
- 4760 CLS: IF BV=1 THEN PRINT "Disk drive "R$":"
- 4770 ON ERROR GOTO 4810: FILES R$+":*.*" 'Display directory
- 4780 ON ERROR GOTO 0: LOCATE 25,41: PRINT "Press any key to continue";
- 4790 IF CG=1 THEN SCREEN ,,2,2 'Display page 2 for C/G
- 4800 E=1: L=0: GOSUB 2320: RETURN 'Get entry & return
- 4810 RESUME 4820
- 4820 ON ERROR GOTO 0: GOTO 4690 'Try again
- 4830 '
- 4840 '
- 4850 '
- 4860 '*** Sub-routine to exit to MENU
- 4870 D$="": BAS$="MENU.BAS"
- 4880 ON ERROR GOTO 4900: OPEN "I",#1,D$+BAS$: CLOSE: ON ERROR GOTO 0
- 4890 CLS: CHAIN D$+BAS$
- 4900 RESUME 4910
- 4910 ON ERROR GOTO 0: GOSUB 2210: COLOR 0,7
- 4920 PRINT " Enter letter of drive containing "BAS$": ";
- 4930 BEEP: COLOR FG,BG
- 4940 LOCATE 24,41: PRINT "Press <Esc> to cancel selection";
- 4950 LOCATE 25,46: E=2: L=1: GOSUB 2320
- 4960 IF R=27 THEN RETURN 'Esc means cancel
- 4970 D$=R$+":": GOTO 4880
- 4980 '
- 4990 '
- 5000 '
- 5010 '*** Sub-routine to exit to BASIC
- 5020 ON ERROR GOTO 0: SCREEN 0,1,0,0: CLS: END
- 5030 '
- 5040 '
- 5050 '
- 5060 '*** Sub-routine to exit to DOS
- 5070 CLS: SYSTEM
- 5080 '
- 5090 '
- 5100 '
- 5110 '*** Print control codes & names
- 5120 '*** Menu items A-Z
- 5130 '*** Control code names precede codes
- 5140 '*** End each code sequence with 255
- 5150 DATA "Clear print buffer & reset printer"
- 5160 DATA 17,24,255
- 5170 DATA "Data Processing print mode"
- 5180 DATA 27,48,255
- 5190 DATA "Correspondence Quality print mode"
- 5200 DATA 27,49,255
- 5210 DATA "Downloaded Character print mode"
- 5220 DATA 27,50,255
- 5230 DATA "Enhanced printing **"
- 5240 DATA 27,72,255
- 5250 DATA "Emphasized printing **"
- 5260 DATA 27,84,255
- 5270 DATA "Stop enhanced/emphasized printing"
- 5280 DATA 27,73,255
- 5290 DATA "10 characters per inch"
- 5300 DATA 30,255
- 5310 DATA "12 characters per inch"
- 5320 DATA 30,28,255
- 5330 DATA "17 characters per inch **"
- 5340 DATA 30,29,255
- 5350 DATA "Double-width characters"
- 5360 DATA 31,255
- 5370 DATA "6 lines per inch"
- 5380 DATA 27,54,255
- 5390 DATA "8 lines per inch"
- 5400 DATA 27,56,255
- 5410 DATA "Underlining on"
- 5420 DATA 27,67,255
- 5430 DATA "Underlining off"
- 5440 DATA 27,68,255
- 5450 DATA "Subscripts/superscripts on"
- 5460 DATA 27,77,27,75,27,76,255
- 5470 DATA "Subscripts/superscripts off"
- 5480 DATA 27,75,27,77,255
- 5490 DATA "Set variable horizontal tab stops"
- 5500 DATA 27,09,255
- 5510 DATA "Set fixed horizontal tab stops"
- 5520 DATA 27,09,255
- 5530 DATA "Clear all tab stops"
- 5540 DATA 27,09,13,255
- 5550 DATA "Set form length (for form-feeds)"
- 5560 DATA 27,70,255
- 5570 DATA "Set top-of-form"
- 5580 DATA 27,05,255
- 5590 DATA "Advance to top-of-form"
- 5600 DATA 12,255
- 5610 DATA "Skip 01-99 lines"
- 5620 DATA 27,11,255
- 5630 DATA "Set left margin"
- 5640 DATA 27,37,67,255
- 5650 DATA "Set space between characters *"
- 5660 DATA 27,78,255
- 5670 '
- 5680 '
- 5690 '*** Print-related functions
- 5700 '*** Menu items 1-8
- 5710 DATA "Download Italics character set"
- 5720 DATA "Print test--all ASCII characters"
- 5730 DATA "Print an ASCII text file"
- 5740 DATA "Print disk directory (BASIC 2.00)"
- 5750 DATA "Display disk directory"
- 5760 DATA "Exit to MENU"
- 5770 DATA "Exit to BASIC"
- 5780 DATA "Exit to DOS"
-